# comun self hosted implementation: bytecode library
# module prefix: b
#
# This module contains basic resource for handling the implementation specific
# comun BC. More advanced BC opeartions, such as its optimization and
# interpretation, are to be implemented elsewhere.
#
# Before including this library, define the following:
#
# - CMN_bBYTECODE_SIZE: Func pushing the num. of CMN_bBytecode cells, to TE 32.
# - CMN_bBytecode:      Ptr to mem in TE 16 where BC will be stored, must point
#                       to a block of at least CMN_bBYTECODE_SIZE free cells.

~"cmn_general.cmn"

~16 ~CMN_bCurrentInstr:0 ~0   # ptr to current instr within the BC
~32 ~CMN_bCurrentInstrAddr ~0 # BC addr of current instr

# Size of BC header in bytes.
CMN_bHEADER_SIZE: 8 .

# instr opcode modes:
CMN_bMODE21:  +b00000000 . # pop 2, push 1
CMN_bMODE1C1: +b00000001 . # pop 1, use C, push 1
CMN_bMODE11:  +b00000010 . # pop 1, push 1
CMN_bMODE01:  +b00000011 . # push 1

# instr opcode groups:
CMN_bOPCODE_AD: +b00100000 .
CMN_bOPCODE_SU: +b00100100 .
CMN_bOPCODE_MU: +b00101000 .
CMN_bOPCODE_DI: +b00101100 .
CMN_bOPCODE_DS: +b00110000 .
CMN_bOPCODE_MO: +b00110100 .
CMN_bOPCODE_MS: +b00111000 .
CMN_bOPCODE_GR: +b01000000 .
CMN_bOPCODE_GE: +b01000100 .
CMN_bOPCODE_SM: +b01001000 .
CMN_bOPCODE_SE: +b01001100 .
CMN_bOPCODE_GS: +b01010000 .
CMN_bOPCODE_BS: +b01010100 .
CMN_bOPCODE_SS: +b01011000 .
CMN_bOPCODE_LS: +b01011100 .
CMN_bOPCODE_EQ: +b01100000 .
CMN_bOPCODE_NE: +b01100100 .
CMN_bOPCODE_BA: +b01101000 .
CMN_bOPCODE_BO: +b01101100 .
CMN_bOPCODE_BX: +b01110000 .
CMN_bOPCODE_LA: +b01110100 .
CMN_bOPCODE_LO: +b01111000 .
CMN_bOPCODE_LX: +b01111100 .
CMN_bOPCODE_SR: +b10000100 .
CMN_bOPCODE_SL: +b10001000 .

# special instr opcodes:
CMN_bOPCODE_END: +b00000000 .
CMN_bOPCODE_NOP: +b00000001 .
CMN_bOPCODE_DES: +b00000010 .
CMN_bOPCODE_COC: +b00000011 .
CMN_bOPCODE_ERR: +b00000100 .
CMN_bOPCODE_CAL: +b00000111 .
CMN_bOPCODE_CAE: +b00001000 .
CMN_bOPCODE_RET: +b00001001 .
CMN_bOPCODE_JIA: +b00001010 .
CMN_bOPCODE_JNA: +b00001011 .
CMN_bOPCODE_JMA: +b00001100 .
CMN_bOPCODE_INI: +b00001111 .
CMN_bOPCODE_PSC: +b00010000 .
CMN_bOPCODE_PAC: +b00010001 .
CMN_bOPCODE_PAX: +b00010010 .
CMN_bOPCODE_PCO: +b00010011 .
CMN_bOPCODE_MEX: +b00010100 .
CMN_bOPCODE_MGE: +b00010101 .
CMN_bOPCODE_PCM: +b00010110 .
CMN_bOPCODE_PUX: +b00010111 .
CMN_bOPCODE_CON: +b00011010 .
CMN_bOPCODE_CND: +b00011011 .
CMN_bOPCODE_SWP: +b00011100 .
CMN_bOPCODE_TRA: +b00011101 .
CMN_bOPCODE_POP: +b00011110 .
CMN_bOPCODE_OUT: +b00011111 .

# typical instr opcodes:
CMN_bOPCODE_ADX: CMN_bOPCODE_AD CMN_bMODE21  | .
CMN_bOPCODE_ADC: CMN_bOPCODE_AD CMN_bMODE1C1 | .
CMN_bOPCODE_SUX: CMN_bOPCODE_SU CMN_bMODE21  | .
CMN_bOPCODE_SUC: CMN_bOPCODE_SU CMN_bMODE1C1 | .
CMN_bOPCODE_MUX: CMN_bOPCODE_MU CMN_bMODE21  | .
CMN_bOPCODE_MUC: CMN_bOPCODE_MU CMN_bMODE1C1 | .
CMN_bOPCODE_DIX: CMN_bOPCODE_DI CMN_bMODE21  | .
CMN_bOPCODE_DIC: CMN_bOPCODE_DI CMN_bMODE1C1 | .
CMN_bOPCODE_DSX: CMN_bOPCODE_DS CMN_bMODE21  | .
CMN_bOPCODE_DSC: CMN_bOPCODE_DS CMN_bMODE1C1 | .
CMN_bOPCODE_MOX: CMN_bOPCODE_MO CMN_bMODE21  | .
CMN_bOPCODE_MOC: CMN_bOPCODE_MO CMN_bMODE1C1 | .
CMN_bOPCODE_MSX: CMN_bOPCODE_MS CMN_bMODE21  | .
CMN_bOPCODE_MSC: CMN_bOPCODE_MS CMN_bMODE1C1 | .
CMN_bOPCODE_GRX: CMN_bOPCODE_GR CMN_bMODE21  | .
CMN_bOPCODE_GRC: CMN_bOPCODE_GR CMN_bMODE1C1 | .
CMN_bOPCODE_GEX: CMN_bOPCODE_GE CMN_bMODE21  | .
CMN_bOPCODE_GEC: CMN_bOPCODE_GE CMN_bMODE1C1 | .
CMN_bOPCODE_SMX: CMN_bOPCODE_SM CMN_bMODE21  | .
CMN_bOPCODE_SMC: CMN_bOPCODE_SM CMN_bMODE1C1 | .
CMN_bOPCODE_SEX: CMN_bOPCODE_SE CMN_bMODE21  | .
CMN_bOPCODE_SEC: CMN_bOPCODE_SE CMN_bMODE1C1 | .
CMN_bOPCODE_GSX: CMN_bOPCODE_GS CMN_bMODE21  | .
CMN_bOPCODE_GSC: CMN_bOPCODE_GS CMN_bMODE1C1 | .
CMN_bOPCODE_BSX: CMN_bOPCODE_BS CMN_bMODE21  | .
CMN_bOPCODE_BSC: CMN_bOPCODE_BS CMN_bMODE1C1 | .
CMN_bOPCODE_SSX: CMN_bOPCODE_SS CMN_bMODE21  | .
CMN_bOPCODE_SSC: CMN_bOPCODE_SS CMN_bMODE1C1 | .
CMN_bOPCODE_LSX: CMN_bOPCODE_LS CMN_bMODE21  | .
CMN_bOPCODE_LSC: CMN_bOPCODE_LS CMN_bMODE1C1 | .
CMN_bOPCODE_EQX: CMN_bOPCODE_EQ CMN_bMODE21  | .
CMN_bOPCODE_EQC: CMN_bOPCODE_EQ CMN_bMODE1C1 | .
CMN_bOPCODE_NEX: CMN_bOPCODE_NE CMN_bMODE21  | .
CMN_bOPCODE_NEC: CMN_bOPCODE_NE CMN_bMODE1C1 | .
CMN_bOPCODE_BAX: CMN_bOPCODE_BA CMN_bMODE21  | .
CMN_bOPCODE_BAC: CMN_bOPCODE_BA CMN_bMODE1C1 | .
CMN_bOPCODE_BOX: CMN_bOPCODE_BO CMN_bMODE21  | .
CMN_bOPCODE_BOC: CMN_bOPCODE_BO CMN_bMODE1C1 | .
CMN_bOPCODE_BXX: CMN_bOPCODE_BX CMN_bMODE21  | .
CMN_bOPCODE_BXC: CMN_bOPCODE_BX CMN_bMODE1C1 | .
CMN_bOPCODE_LAX: CMN_bOPCODE_LA CMN_bMODE21  | .
CMN_bOPCODE_LAC: CMN_bOPCODE_LA CMN_bMODE1C1 | .
CMN_bOPCODE_LOX: CMN_bOPCODE_LO CMN_bMODE21  | .
CMN_bOPCODE_LOC: CMN_bOPCODE_LO CMN_bMODE1C1 | .
CMN_bOPCODE_LXX: CMN_bOPCODE_LX CMN_bMODE21  | .
CMN_bOPCODE_LXC: CMN_bOPCODE_LX CMN_bMODE1C1 | .
CMN_bOPCODE_BNO: +b10000000 CMN_bMODE11      | .
CMN_bOPCODE_SRX: CMN_bOPCODE_SR CMN_bMODE21  | .
CMN_bOPCODE_SRC: CMN_bOPCODE_SR CMN_bMODE1C1 | .
CMN_bOPCODE_SLX: CMN_bOPCODE_SL CMN_bMODE21  | .
CMN_bOPCODE_SLC: CMN_bOPCODE_SL CMN_bMODE1C1 | .
CMN_bOPCODE_ADR: +b11110000 CMN_bMODE01      | .
CMN_bOPCODE_INU: +b11111000 CMN_bMODE01      | .
CMN_bOPCODE_INP: +b11111100 CMN_bMODE01      | .

CMN_bDES_IF:      1  .
CMN_bDES_ELSE:    2  .
CMN_bDES_ENDIF:   3  .
CMN_bDES_LOOP:    4  .
CMN_bDES_BREAK:   5  .
CMN_bDES_ENDLOOP: 6  .
CMN_bDES_FUNDEF:  7  .
CMN_bDES_EXIT:    8  .
CMN_bDES_GOTO:    9  .
CMN_bDES_LABEL:   10 .
CMN_bDES_NEWLINE: 11 .
CMN_bDES_NEWFILE: 12 .
CMN_bDES_ENDFILE: 13 .

# arg: 3addr
# Sets the current instr pointer within BC to 3addr.
CMN_bCurrentInstrSetAddr:
  ~32 $:CMN_bCurrentInstrAddr ~0
  ~16 0 ~0 CMN_bHEADER_SIZE 1 |> >16
    
  ~16
    $CMN_bBytecode>CMN_bCurrentInstr
    $+CMN_bCurrentInstr
  ~0

  ~32 $CMN_bCurrentInstrAddr +xffff <= ? ~0
    ~16 0 ~0
    ~32 $CMN_bCurrentInstrAddr >16 ~0
    ~16 $+CMN_bCurrentInstr ~0
  ;
    # addr bigger than 16 bits, use loop

    ~32
      $CMN_bCurrentInstrAddr @'
        --
        ~16 $>CMN_bCurrentInstr ~0
      .
      ^
    ~0
  .
.

# ret: instr
# Gets the currently pointed 16 bit instr.
CMN_bCurrentInstrGet: 0 ~16 $CMN_bCurrentInstr >0 ~0 .

# arg: 3adr
# ret: instr
# Gets instr at given addr in BC.
CMN_bGetInstrAt:
  ~32
    $CMN_bCurrentInstrAddr >< CMN_bCurrentInstrSetAddr
    CMN_bCurrentInstrGet
    CMN_bCurrentInstrSetAddr
  ~0
.

# Shifts to the next instr.
CMN_bCurrentInstrShift:
  ~16 $>CMN_bCurrentInstr ~0
  ~32 $CMN_bCurrentInstrAddr ++ $:CMN_bCurrentInstrAddr ~0
.

# Shifts to previous instr.
CMN_bCurrentInstrShiftBack:
  ~16 $<CMN_bCurrentInstr ~0
  ~32 $CMN_bCurrentInstrAddr -- $:CMN_bCurrentInstrAddr ~0
.

# ret: 2cs
# Computes the BC checksum, i.e. sum of all bytes in BC section mod 256.
CMN_bChecksum:
  # TODO: untested
  ~16 0 ~0 CMN_bHEADER_SIZE >16

  ~16
    $CMN_bBytecode>_CMN_g2P1
    1 |> $+_CMN_g2P1

    0 # result

    $_CMN_g2P1 @
      $_CMN_g2P1 $0 8 |> + +
      $>_CMN_g2P1
      $_CMN_g2P1
    .

    +xff &
  ~0
.

# arg: opcode typeEnv noPop const constCont
# ret: instr
# Creates a 16 bit instr code, typeEnv is 0, 1, 2 or 3, noPop is 0 (may pop) or
# 1 (won't pop), const is 0 to 16 (IC), constCont is 0 or 1
# (IC will continue).
CMN_bMakeInstr: 4 |< | >< 5 |< | >< 6 |< | 8 |< | .

CMN_bInstrOpcode: +x00ff & .
CMN_bInstrTypeEnv: 14 |> +b11 & .
CMN_bInstrWontPop: 13 |> 1 & .
CMN_bInstrConstContinues: 12 |> 1 & .
CMN_bInstrIsTypical: 4 |> +x0f & 2 >= .

# arg: opcode
# ret: bool
# Says if given opcode represents an instr that makes use of the NoPop bit.
CMN_bOpcodeUsesNoPop:    
  $0 CMN_bOPCODE_RET <=
  $1 CMN_bOPCODE_JMA = |
  $1 CMN_bOPCODE_INI = |
  $1 CMN_bOPCODE_PSC = |
  $1 CMN_bOPCODE_PAC = |
  $1 CMN_bOPCODE_PCM = |
  $1 CMN_bOPCODE_ADR = |
  >< CMN_bOPCODE_INP = |
  !!
.

# arg: opcode
# ret: bool
# Says if given opcode makes use of TE bits.
CMN_bOpcodeUsesTypeEnv:
  $0 CMN_bOPCODE_RET <= $1 CMN_bOPCODE_COC != &
  $1 CMN_bOPCODE_JMA = |
  >< CMN_bOPCODE_INI = |
  !!
.

CMN_bCurrentInstrTypeEnv: CMN_bCurrentInstrGet CMN_bInstrTypeEnv .

# arg: instr
# ret: bool
# Checks if instr may touch the ptr table (only using ST addr doesn't count).
CMN_bInstrUsesPtrs:
  CMN_bInstrOpcode $0 CMN_bOPCODE_PSC >= >< CMN_bOPCODE_PCM <= &
.

# ret: p2 p1
# Analyzes currently pointed instr, pushes p2 and p1, each one being the num of
# ptrs the instr uses. If given pointer is not used, the val will be -1 (i.e. if
# P1 is -1, the instr doesn't work with ptrs). 
CMN_bCurrentInstrExtractPtrs:
  CMN_bCurrentInstrGet $0 CMN_bInstrUsesPtrs ?
    CMN_bInstrOpcode

    $0 CMN_bOPCODE_PAX = $1 CMN_bOPCODE_MEX = || $1 CMN_bOPCODE_MGE = || ?
      # pointer in C
      ^ -1 CMN_bCurrentInstrGetConst
    ;
      # pointer in C1 and maybe also C2
      
      CMN_bCurrentInstrGetConsts32

      0 ~32 >0 ~0
      0 ~32 >0 ~0
      ><

      $2 CMN_bOPCODE_PCO != $3 CMN_bOPCODE_PCM != && ?
        # C2 pointer not used, set to -1

         -1 $:2
      .

      >< $:2
    .
  ;
    ^ -1 -1
  .
.

# ret: mems
# Pushes a num that in its lowest 4 bits says which TE mems get affected by it.
CMN_bInstrAffectsMems:
  $0 CMN_bInstrIsTypical ?
    CMN_bInstrTypeEnv 1 >< |<
  ;
    $0 CMN_bInstrOpcode CMN_bOPCODE_TRA = ?
      $0 8 |> +x0f & 1 >< |<
      >< CMN_bInstrTypeEnv 1 >< |<  |
    ;
      $0 CMN_bInstrOpcode
      $0 CMN_bOPCODE_RET > ><
      $0 CMN_bOPCODE_PCO != ><
      $0 CMN_bOPCODE_PAC != ><
      $0 CMN_bOPCODE_PSC != ><
      CMN_bOPCODE_JMA != & & & & ?
        CMN_bInstrTypeEnv 1 >< |<
      ;
        ^ 0
      .
    .
  .
.

# ret: 3const
# Gets currently pointed instr's IC (considering also potential continuation in
# following COC instrs).
CMN_bCurrentInstrGetConst32:
  ~16 $CMN_bCurrentInstr>_CMN_g2P1 ~0
  ~32
    0 # shift
    0 # result (r)

    1 @
      0
      ~16 $_CMN_g2P1 >32 $>_CMN_g2P1 ~32
      $0 8 |> +x0f & $3 |< # constAdd
      $3 4 + $:4           # shift += 4
      >< 12 |> 1 &         # contCont
      ^
      +                    # result += constAdd
      $>0 $>0
      $:1
    .

    >< ^
  ~0
.

# ret: const
CMN_bCurrentInstrGetConst: 0 ~32 CMN_bCurrentInstrGetConst32 >0 ~0 .

# ret: bitCount
# Pushes the bit count of currently pointed instr's IC (will be a multip. of 4).
CMN_bCurrentInstrGetConstBits:
  0 # prepare space

  ~16
    $CMN_bCurrentInstr>_CMN_g2P1

    0
    1 @
      ++
      $_CMN_g2P1 12 |> 1 & # const. continues?
      $>_CMN_g2P1
    .

    2 |< # times 4
    >0
  ~0
.

# ret: 3c2 3c1
# Considers currently pointed instr as having two ICs, pushes them.
CMN_bCurrentInstrGetConsts32:
  CMN_bCurrentInstrGetConstBits 1 |> $0
  ~32
    CMN_bCurrentInstrGetConst32 $0

    0 ~0 >32 ~32
    |>
    ><

    +xffffffff
    0 ~0 >32 ~32
    |< ! &
  ~0
.

# ret: C2 C1
CMN_bCurrentInstrGetConsts:
  CMN_bCurrentInstrGetConsts32
  0 ~32 >0 ~0 0 ~32 >0 ~0 ><
.

# Outputs BC in binary form.
CMN_bOutput:
  ~16 $CMN_bBytecode>_CMN_g2P1 ~0

  CMN_bHEADER_SIZE 1 |> @'
    ~16 $_CMN_g2P1 +xff & -> $_CMN_g2P1 8 |> -> $>_CMN_g2P1 ~0
    --
  .
  ^

  ~32 0 CMN_bCurrentInstrSetAddr ~0

  1 @
    CMN_bCurrentInstrGet
    $0 +xff & ->
    $0 8 |> ->
    CMN_bCurrentInstrShift
  .
.

# ret: line
# If debug info is present in BC, returns source line of current instr (else 0).
CMN_bCurrentInstrGetSrcLine:
  1

  ~16 0 ~0 CMN_bOPCODE_DES 0 0 CMN_bDES_NEWLINE 0 CMN_bMakeInstr >16

  ~16
    $CMN_bBytecode>_CMN_g2P1

    1 @
      $0 $_CMN_g2P1 = ?
        ~0 ++ ~16
      .      

      $>_CMN_g2P1
      $_CMN_g2P1=CMN_bCurrentInstr 1 !=
    .

    ^
  ~0
.

# Decrements IC (even continuing in COCs) by one (does nothing for zero).
CMN_bCurrentInstrDecrementConst:
  ~16
    $CMN_bCurrentInstr +x1f00 & !! ? # IC = 0?
      !.
    .

    $CMN_bCurrentInstr>_CMN_g2P1

    @@
      $_CMN_g2P1 8 |> +x0f & -- +x0f & # decremented const
 
      $0 8 |< $_CMN_g2P1 +xf0ff & | $:_CMN_g2P1

      +x0f = ? # underflow?
        $_CMN_g2P1 +x1000 & ?
          $>_CMN_g2P1
        ;
          !@ # underflow with no const cont, probably shouldn't happen
        .
      ;
        @@ # remove freed instrs
          $_CMN_g2P1 +x1f00 & !!
          $_CMN_g2P1 +x000f & 0 ~0 CMN_bOPCODE_COC >16 ~16 = & ?
            # COC, zero and no const cont => replace with NOP
            0 ~0 CMN_bOPCODE_NOP >16 ~16 $:_CMN_g2P1
            $<_CMN_g2P1
            $_CMN_g2P1 1 12 |< ! & $:_CMN_g2P1 # zero const cont bit
          ;
            !@
          .
        .

        !@
      .
    .
  ~0
.

# ret: bool
# Checks BC for very basic sanity (magic num., checksum, ...), returns 1 or 0.
CMN_bCheckSanity:
  0

  ~16
    $CMN_bBytecode>_CMN_g2P1 $>_CMN_g2P1 $>_CMN_g2P1
    $_CMN_g2P1 CMN_bChecksum =
    $CMN_bBytecode +x4243 = & >0
  ~0
.
